perm filename MFAIL.FAI[NEW,LCS]8 blob
sn#581867 filedate 1981-04-22 generic text, type T, neo UTF8
TITLE MFAIL
ENTRY LL ;;4/81
INTERNAL RJBX,CENTX,EXTEN,JDRAW,CENTER,LINX,UNPACK,ROFF
INTERNAL NOZERO,EXCH,BMS,IABS,RHORZ,ABS,RTLINE,FLOAT,IFIX
EXTERNAL .COMM.,STF,POSI,LINES,BM,XRN,AMOD,PLTR,THICK
;;4/81 EXTERNAL .COMM.,STF,POSI,LL,LINES,BM,XRN,AMOD,PLTR,THICK
LL: 0
RJBX: 0 ;R3=R3+R*RSTJ2
MOVE 2,@(16)
FMPR 2,STF+=8
FADRM 2,.COMM.+=4
JRA 16,1(16)
CENTX: 0 ;CENTX=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
JSA 16,AMOD
JUMP .COMM.+5
JUMP [=100.0] ; -81 TURNS TO 19, 81 TURNS TO -19!!!
MOVE 1,.COMM.+1 ;IF(JA.EQ.8)GO TO CENTXX
CAIE 1,4 ;IF(JA.EQ.4.OR.JA.GT.6)GO TO CENTXX
CAIL 1,7 ; P4 MINIS IN NOTES,RESTS,BEAMS,CLEFS JA¬1,2,3,6
;;1/81 CAIN 1,=8 ; WORDS, LINES, STAFF (JA=16,4,8) CAN BE BELOW -80
JRST CENTXX
CAMGE [-80.0] ;IF(R4.LT.-80)R4=R4+100
FADR [100.0] ; CATCHES R4=-95 ETC.
CAML [80.0] ;IF(R4.GE.80)R4=R4-100
FSBR [100.0] ; CATCHES NEG. MINIS ETC.
MOVEM .COMM.+5 ;[R4=AMOD(R4,100.0)]***********
CENTXX: FMPR [=7.0]
FSBR [=18.0]
FMPR STF+=8
FADR POSI+=9
MOVEM .COMM.+2
JRA 16,(16)
EXTEN: 0 ;FUNCTION EXTEN(X)
HRRM 16,.+2
JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
JUMP @0
JUMP [=1.0]
FMPR [=10.0]
JRA 16,1(16)
JDRAW: 0 ;SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
;COMMON/LL/LL
MOVE 13,@4(16) ;DIMENSION M(1)
FMPR 13,@3(16) ;RC=RX*RSTJ2
MOVE 14,@5(16) ;RD=RY*RSTJ2
FMPR 14,@3(16) ;13 HAS RC, 14 HAS RD
MOVE 3,@(16) ;DO 2 K=2,M(1)
MOVEI 12,@(16) ; BRING IN ADR. OF M (ZERO LEFT HALF)
MOVE 10,(12) ;PUT ADR. OF M IN 10
ADDI 10,-1(12)
L2: AOJ 12, ; SET UP LOOP
CAILE 12,(10) ; SEE IF WE'VE PASSED END OF LOOP
JRA 16,6(16) ; GO HOME
HRRZM 12,.+4 ; PUT ADR. OF VALUE M(K) IN LAST JUMP
; CALL UNPACK(A,B,M(K))
JSA 16,UNPACK
JUMP 6 ;AA
JUMP 7 ;BB
JUMP
;2 CALL LINES(FLOAT(A)*RC+R3,FLOAT(B)*RD+CENTR,LL)
FLTR 6,6
FMPR 6,13
FADR 6,@1(16)
FLTR 7,7
FMPR 7,14
FADR 7,@2(16)
JSA 16,LINES
JUMP 6 ;AA
JUMP 7 ;BB
JUMP LL
JRST L2
CENTER: 0 ; SUBROUTINE CENTER(CNTR)
; TO CENTER ITEMS CREATED WITH DRAWING PROG.
; COMMON /STF/RSTFAC(8),RSTJ2
; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
; COMMON/POSI/STF(8),JJ2,POS
; EQUIVALENCE (R4,RJQ(2))
JSA 16,AMOD ;CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
JUMP .COMM.+5
JUMP [=100.0]
FMPR [=7.0]
FADR [=2.0]
FMPR STF+=8
FADR POSI+=9
MOVEM @(16)
JRA 16,1(16)
LINX: 0 ; SUBROUTINE LINX(A,B,C,D)
; C SAVES SPACE FOR SINGLE LINES.
MOVE 4,@(16) ;CALL LINES(A,B,3)
MOVE 6,@1(16)
;CALL LINES(C,D,2)
JSA 16,LINES
JUMP 4
JUMP 6
JUMP [=3]
MOVE 6,@2(16)
;; 6 AND 4 ARE FREE IN LINES MOVEM CC
MOVE 4,@3(16)
JSA 16,LINES
JUMP 6
JUMP 4
JUMP [=2]
JRA 16,4(16)
UNPACK: 0 ; SUBROUTINE UNPACK(M,N,I)
; COMMON/LL/L
;C L IS FOR VIS. OR INVIS. LINES.
MOVEI 1,2 ; L=2
MOVE 2,@2(16) ; N=I
MOVE 4,2
IDIV 2,[=100000000] ; M=N/100000000
JUMPE 2,M2 ; IF(M.EQ.0)GO TO 2
AOJ 1, ; L=3
MOVE 4,3 ; N=N-100000000*M
M2: MOVEM 1,LL
IDIVI 4,23420 ;2 M=N/10000
; 5 IS N=MOD(N,10000)
CAIG 4,1750 ; IF(M.GT.1000)M=1000-M
JRST N2
MOVNS 4
ADDI 4,1750
N2: CAIG 5,1750 ; IF(N.GT.1000)N=1000-N
JRST P2
MOVNS 5
ADDI 5,1750
P2: MOVEM 4,@(16)
MOVEM 5,@1(16)
JRA 16,3(16)
ROFF: 0 ; FUNCTION ROFF(R)
SKIPGE 1,@(16) ; IF(R)S=-S
JRST ROFF1
MOVE [0.5] ; S=.5
FADR 1 ; ROFF=R+S
JRA 16,1(16)
ROFF1: MOVN [0.5]
JRST .-3
NOZERO: 0 ;SUBROUTINE NOZERO(X)
SKIPE @(16) ; IF(X.EQ.0)X=1
JRA 16,1(16)
MOVSI 201400 ; MAKE ALL ZEROS INTO ONES.
MOVEM @(16)
JRA 16,1(16)
EXCH: 0 ; SUBROUTINE EXCH(X,Y)
MOVE @(16)
EXCH 0,@1(16)
MOVEM 0,@(16)
JRA 16,2(16)
BMS: 0 ; SUBROUTINE BMS
MOVE BM+1 ;COMMON/STF/RSTFAC(-3/4),RSTJ2/BM/RA,RC,RKY
FMPR STF+=8 ; CALL LINES(RA,RJY+RC*RSTJ2,2)
FADR BM+2
MOVEM CENTX
JSA 16,LINES ; END
JUMP BM
JUMP CENTX
JUMP [2]
JRA 16,(16)
ABS: 0
SKIPA
IABS: 0 ; FUNCTION IABS(N)
MOVM 0,@(16) ;BECAUSE IABS IN LIB40 HAS A BUG.
JRA 16,1(16) ; IABS=N ; IF(N)IABS=-N
RHORZ: 0 ; FUNCTION RHORZ(R)
MOVE @(16) ; RHORZ=R*5.96-596.
FMPR [=5.96]
FSBR [=596.0]
JRA 16,1(16)
RTLINE: 0 ;FUNCTION RTLINE(L)
MOVE 2,.COMM. ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
;%%%%%% CAMLE 2,[=4.0] ;RTLINE=-1
CAMLE 2,[=7.0] ;RTLINE=-1
JRST ZRO ;IF(R2.GT.4)GO TO 1 %%%%%.GT.7
;IF(RN(L+2).NE.R2)RETURN
MOVE 3,@(16) ; 1 RTLINE=0
SETO
CAMN 2,XRN+1(3)
ZRO: SETZ
JRA 16,1(16)
FLOAT: 0
FLTR 0,@(16)
JRA 16,1(16)
IFIX: 0
MOVE 0,@(16)
JUMPGE 0,.+5
MOVNS 0
KIFIX
MOVNS 0
JRA 16,1(16)
KIFIX
JRA 16,1(16)
THICK: 0 ;RETURNS NUMBER OF THICKNESSES IN J8 AND "SCALED" STEP IN R8
; NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
JSA 16,AMOD ; R8=AMOD(R8,100.0)
JUMP .COMM.+=9
JUMP [100.0]
MOVE 1,.COMM.+=29 ; J9=J8/100
IDIVI 1,=100 ;
KIFIX 3,0 ; J8=R8
SETO 2, ; J4=-1
; FLAG FOR SINGLE ADDED VERTICAL THICKNESS, NO MATTER WHAT SIZE. R8=.5
FLTR 3,3
CAME 3,0 ; IF(R8.NE.J8)J4=0
SETZ 2,
MOVE 4,STF+=8 ; R9=RSTJ2*DIS
; R8 AND R9 ARE FACTORS TO CAUSE RIGHT NUM OF LINES FOR THICKNESS.
FMPR 4,PLTR+2
FMPR 0,4 ; J8=J8*R9
FLTR 1,1 ; J9=J9*R9
FMPR 1,4
SKIPE 1 ; IF(J9.NE.0.AND.J8.NE.0)J9=J8
SKIPN 0
SKIPA
MOVE 1,0
; IF BOTH X AND Y THICKNESS ARE USED THEY WILL BECOME EQUAL!
MOVE 3,[1.0]
;; JUMPL 2,TH1 ; IF(J4)GO TO 1
SKIPL 2
MOVE 1,[1.0] ; J9=1
; SINGLE ADDED THICKNESS, NO MATTER WHAT SIZE.; R8=1
;; SKIPA
;;TH1: FDVR 3,PLTR+2 ; R8=1/DIS
;; MOVEM 3,.COMM.+=9
KIFIX 0,0
MOVEM 0,.COMM.+=29 ; J8
KIFIX 1,1
MOVEM 1,.COMM.+=30 ; J9
JRA 16,(16)
END